home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tk8.4 / demos / rmt < prev    next >
Text File  |  2001-10-29  |  5KB  |  211 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. # rmt --
  6. # This script implements a simple remote-control mechanism for
  7. # Tk applications.  It allows you to select an application and
  8. # then type commands to that application.
  9. #
  10. # RCS: @(#) $Id: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $
  11.  
  12. wm title . "Tk Remote Controller"
  13. wm iconname . "Tk Remote"
  14. wm minsize . 1 1
  15.  
  16. # The global variable below keeps track of the remote application
  17. # that we're sending to.  If it's an empty string then we execute
  18. # the commands locally.
  19.  
  20. set app "local"
  21.  
  22. # The global variable below keeps track of whether we're in the
  23. # middle of executing a command entered via the text.
  24.  
  25. set executing 0
  26.  
  27. # The global variable below keeps track of the last command executed,
  28. # so it can be re-executed in response to !! commands.
  29.  
  30. set lastCommand ""
  31.  
  32. # Create menu bar.  Arrange to recreate all the information in the
  33. # applications sub-menu whenever it is cascaded to.
  34.  
  35. . configure -menu [menu .menu]
  36. menu .menu.file
  37. menu .menu.file.apps  -postcommand fillAppsMenu
  38. .menu add cascade  -label "File"  -underline 0  -menu .menu.file
  39. .menu.file add cascade  -label "Select Application"  -underline 0 \
  40.     -menu .menu.file.apps
  41. .menu.file add command  -label "Quit"  -command "destroy ."  -underline 0
  42.  
  43. # Create text window and scrollbar.
  44.  
  45. text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
  46. scrollbar .s -command ".t yview"
  47. grid .t .s -sticky nsew
  48. grid rowconfigure . 0 -weight 1
  49. grid columnconfigure . 0 -weight 1
  50.  
  51. # Create a binding to forward commands to the target application,
  52. # plus modify many of the built-in bindings so that only information
  53. # in the current command can be deleted (can still set the cursor
  54. # earlier in the text and select and insert;  just can't delete).
  55.  
  56. bindtags .t {.t Text . all}
  57. bind .t <Return> {
  58.     .t mark set insert {end - 1c}
  59.     .t insert insert \n
  60.     invoke
  61.     break
  62. }
  63. bind .t <Delete> {
  64.     catch {.t tag remove sel sel.first promptEnd}
  65.     if {[.t tag nextrange sel 1.0 end] == ""} {
  66.     if [.t compare insert < promptEnd] {
  67.         break
  68.     }
  69.     }
  70. }
  71. bind .t <BackSpace> {
  72.     catch {.t tag remove sel sel.first promptEnd}
  73.     if {[.t tag nextrange sel 1.0 end] == ""} {
  74.     if [.t compare insert <= promptEnd] {
  75.         break
  76.     }
  77.     }
  78. }
  79. bind .t <Control-d> {
  80.     if [.t compare insert < promptEnd] {
  81.     break
  82.     }
  83. }
  84. bind .t <Control-k> {
  85.     if [.t compare insert < promptEnd] {
  86.     .t mark set insert promptEnd
  87.     }
  88. }
  89. bind .t <Control-t> {
  90.     if [.t compare insert < promptEnd] {
  91.     break
  92.     }
  93. }
  94. bind .t <Meta-d> {
  95.     if [.t compare insert < promptEnd] {
  96.     break
  97.     }
  98. }
  99. bind .t <Meta-BackSpace> {
  100.     if [.t compare insert <= promptEnd] {
  101.     break
  102.     }
  103. }
  104. bind .t <Control-h> {
  105.     if [.t compare insert <= promptEnd] {
  106.     break
  107.     }
  108. }
  109. auto_load tkTextInsert
  110. proc tkTextInsert {w s} {
  111.     if {$s == ""} {
  112.     return
  113.     }
  114.     catch {
  115.     if {[$w compare sel.first <= insert]
  116.         && [$w compare sel.last >= insert]} {
  117.         $w tag remove sel sel.first promptEnd
  118.         $w delete sel.first sel.last
  119.     }
  120.     }
  121.     $w insert insert $s
  122.     $w see insert
  123. }
  124.  
  125. .t configure -font {Courier 12}
  126. .t tag configure bold -font {Courier 12 bold}
  127.  
  128. # The procedure below is used to print out a prompt at the
  129. # insertion point (which should be at the beginning of a line
  130. # right now).
  131.  
  132. proc prompt {} {
  133.     global app
  134.     .t insert insert "$app: "
  135.     .t mark set promptEnd {insert}
  136.     .t mark gravity promptEnd left
  137.     .t tag add bold {promptEnd linestart} promptEnd
  138. }
  139.  
  140. # The procedure below executes a command (it takes everything on the
  141. # current line after the prompt and either sends it to the remote
  142. # application or executes it locally, depending on "app".
  143.  
  144. proc invoke {} {
  145.     global app executing lastCommand
  146.     set cmd [.t get promptEnd insert]
  147.     incr executing 1
  148.     if [info complete $cmd] {
  149.     if {$cmd == "!!\n"} {
  150.         set cmd $lastCommand
  151.     } else {
  152.         set lastCommand $cmd
  153.     }
  154.     if {$app == "local"} {
  155.         set result [catch [list uplevel #0 $cmd] msg]
  156.     } else {
  157.         set result [catch [list send $app $cmd] msg]
  158.     }
  159.     if {$result != 0} {
  160.         .t insert insert "Error: $msg\n"
  161.     } else {
  162.         if {$msg != ""} {
  163.         .t insert insert $msg\n
  164.         }
  165.     }
  166.     prompt
  167.     .t mark set promptEnd insert
  168.     }
  169.     incr executing -1
  170.     .t yview -pickplace insert
  171. }
  172.  
  173. # The following procedure is invoked to change the application that
  174. # we're talking to.  It also updates the prompt for the current
  175. # command, unless we're in the middle of executing a command from
  176. # the text item (in which case a new prompt is about to be output
  177. # so there's no need to change the old one).
  178.  
  179. proc newApp appName {
  180.     global app executing
  181.     set app $appName
  182.     if !$executing {
  183.     .t mark gravity promptEnd right
  184.     .t delete "promptEnd linestart" promptEnd
  185.     .t insert promptEnd "$appName: "
  186.     .t tag add bold "promptEnd linestart" promptEnd
  187.     .t mark gravity promptEnd left
  188.     }
  189.     return {}
  190. }
  191.  
  192. # The procedure below will fill in the applications sub-menu with a list
  193. # of all the applications that currently exist.
  194.  
  195. proc fillAppsMenu {} {
  196.     set m .menu.file.apps
  197.     catch {$m delete 0 last}
  198.     foreach i [lsort [winfo interps]] {
  199.     $m add command -label $i -command [list newApp $i]
  200.     }
  201.     $m add command -label local -command {newApp local}
  202. }
  203.  
  204. set app [winfo name .]
  205. prompt
  206. focus .t
  207.  
  208. # Local Variables:
  209. # mode: tcl
  210. # End:
  211.